﻿Imports System.Runtime.InteropServices
Imports System.Text
Imports System.IO


Public Class FocusMonitor

#Region "Globals"

    Public Version As String = "1.0.0"

    Public UserDataFolder = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) & "\FocusSpy"

    Public NoFGWindow As Boolean = False

    Public RepProps As New List(Of String)
    Public TreeDic As New Dictionary(Of String, Boolean)
    Public SkipTreeSave As Boolean = False

    Public LastProcID As Integer = 0
    Public LastWndTitle As String = Nothing
    Public LasthWnd As IntPtr = 0

    Private Const C_SEPARATOR As Char = ";"c   'Separator used to store props in my.settings

#End Region

#Region "Pinvokes"
    <DllImport("user32.dll", EntryPoint:="GetWindowThreadProcessId")> _
    Private Shared Function GetWindowThreadProcessId(<InAttribute()> ByVal hWnd As IntPtr, ByRef lpdwProcessId As Integer) As Integer
    End Function

    <DllImport("user32.dll", EntryPoint:="GetForegroundWindow")> Private Shared Function GetForegroundWindow() As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
    End Function

    <DllImport("user32.dll", EntryPoint:="GetWindowTextW")> _
    Private Shared Function GetWindowTextW(<InAttribute()> ByVal hWnd As IntPtr, <OutAttribute(), MarshalAs(UnmanagedType.LPWStr)> ByVal lpString As StringBuilder, ByVal nMaxCount As Integer) As Integer
    End Function
#End Region

    Protected Overrides ReadOnly Property ShowWithoutActivation() As Boolean
        Get
            Return True
        End Get
    End Property

    Private Sub Form1_FormClosing(sender As Object, e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        If Not SkipTreeSave Then
            SaveNodes()
        End If
    End Sub

    Private Sub FocusMonitor_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        SetStyle(ControlStyles.OptimizedDoubleBuffer, True)

        OperationsSetup()
        FormSetup()

    End Sub

    Private Sub OperationsSetup()

        If Not Directory.Exists(UserDataFolder) Then
            Directory.CreateDirectory(UserDataFolder)
        End If

        If File.Exists(UserDataFolder & "\TreeSetts.sav") Then
            LoadNodes()
        End If


        ProcTimer.Interval = My.Settings.Pollms
    End Sub

    Private Sub ProcTimer_Tick(sender As Object, e As EventArgs) Handles ProcTimer.Tick

        Dim hWnd As IntPtr = GetForegroundWindow()

        If Not hWnd.Equals(IntPtr.Zero) Then
            Try

                Dim Report As Boolean = False
                Dim Key As String = " "
                Dim bg As Color = Color.Black
                Dim fg As Color = Color.LimeGreen



                Dim lgth As Integer = GetWindowTextLength(hWnd)
                Dim wTitle As New System.Text.StringBuilder("", lgth + 1)
                If lgth > 0 Then
                    GetWindowTextW(hWnd, wTitle, wTitle.Capacity)
                End If
                Dim wProcID As Integer = Nothing
                GetWindowThreadProcessId(hWnd, wProcID)
                Dim Proc As Process = Process.GetProcessById(wProcID)
                'Dim wFileName As String = ""
                'Try
                '    wFileName = Proc.MainModule.FileName
                'Catch ex As Exception
                '    wFileName = "Cannot Retrieve MainModule Filename"
                'End Try
                'Dim ForeProc As Process = Process.GetProcessById(wProcID)

                If My.Settings.RepPollTick Then Report = True

                If My.Settings.RepWndText AndAlso wTitle.ToString <> LastWndTitle Then
                    Report = True
                    Key = "T"
                    bg = Color.LightSkyBlue
                    fg = Color.Black
                End If

                If My.Settings.RephWndChnage AndAlso hWnd <> LasthWnd Then
                    Report = True
                    Key = "H"
                    bg = Color.DarkSeaGreen
                    fg = Color.Black
                End If

                If My.Settings.RepProcID AndAlso wProcID <> LastProcID Then
                    Report = True
                    Key = "P"
                    bg = Color.Gold
                    fg = Color.Black
                End If

                LastProcID = wProcID
                LastWndTitle = wTitle.ToString
                LasthWnd = hWnd

                If Report Then
                    If My.Settings.HighlightChanges Then
                        MainRTB.SelectionColor = fg
                        MainRTB.SelectionBackColor = bg
                    Else
                        MainRTB.SelectionColor = Color.LimeGreen
                        MainRTB.SelectionBackColor = Color.Black
                    End If

                    MainRTB.AppendText(DateTime.Now.ToString("H:mm:ss-ff") & " [" & Key & "] " &
                                        PropertiesString(hWnd) & vbCrLf)
                    MainRTB.SelectionStart = MainRTB.Text.Length
                    MainRTB.ScrollToCaret()
                End If

            Catch ex As Exception

                If My.Settings.HighlightChanges Then
                    MainRTB.SelectionColor = Color.WhiteSmoke
                    MainRTB.SelectionBackColor = Color.Red
                Else
                    MainRTB.SelectionColor = Color.LimeGreen
                    MainRTB.SelectionBackColor = Color.Black
                End If
                MainRTB.AppendText(DateTime.Now.ToString("H:mm:ss-ff") & " [!] " &
                                   "ERROR: " & ex.Message & vbCrLf)
            End Try
            NoFGWindow = False

        Else
            If NoFGWindow = False Then
                If My.Settings.HighlightChanges Then
                    MainRTB.SelectionColor = Color.WhiteSmoke
                    MainRTB.SelectionBackColor = Color.DarkSlateBlue
                Else
                    MainRTB.SelectionColor = Color.LimeGreen
                    MainRTB.SelectionBackColor = Color.Black
                End If
                MainRTB.AppendText(DateTime.Now.ToString("H:mm:ss-ff") & " [X] " &
                                   "NO FOREGROUND WINDOW" & vbCrLf)
            End If
            NoFGWindow = True
        End If

    End Sub

    Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
         (ByVal hWnd As Long, _
          ByVal lpClassName As String, _
          ByVal nMaxCount As Long) As Long

    Private Function PropertiesString(hWnd As IntPtr) As String

        Dim lgth As Integer = GetWindowTextLength(hWnd)
        Dim wTitle As New System.Text.StringBuilder("", lgth + 1)
        If lgth > 0 Then
            GetWindowTextW(hWnd, wTitle, wTitle.Capacity)
        End If
        Dim wProcID As Integer = Nothing
        GetWindowThreadProcessId(hWnd, wProcID)
        Dim Proc As Process = Process.GetProcessById(wProcID)
        Dim wFileName As String = ""
        Try
            wFileName = Proc.MainModule.FileName
        Catch ex As Exception
            wFileName = "Cannot Retrieve MainModule Filename"
        End Try
        Dim ForeProc As Process = Process.GetProcessById(wProcID)

        Dim s As String = Nothing

        RefreshPropsList()

        If RepProps.Count < 1 Then
            s = "NO PROPERTIES SELECTED   "
        Else
            For Each repprop As String In RepProps
                Select Case repprop
                    Case "ProcessID"
                        s = s & wProcID.ToString("D5") & " | "
                    Case "WindowHandle"
                        s = s & hWnd.ToString("D7") & " | "
                    Case "ProcessName"
                        s = s & ForeProc.ProcessName & " | "
                    Case "WindowTitle"
                        s = s & wTitle.ToString & " | "

                        'WINDOW SUBS
                    Case "WindowClass"

                        Dim sClassName As String = "{null}"
                        Call GetClassName(hWnd, sClassName, 256)
                        s = s & sClassName & " | "

                        'PROCESS SUBS
                    Case "MainModuleFilename"
                        s = s & wFileName.ToString & " | "
                    Case "MainModuleName"
                        s = s & Proc.MainModule.ModuleName & " | "

                    Case "ProcessStartTime"
                        s = s & Proc.StartTime & " | "

                    Case "ProcessThreadsCount"
                        s = s & Proc.Threads.Count & " | "

                        'startinfo
                    Case "StartInfoArgs"
                        s = s & Proc.StartInfo.Arguments.ToString & " | "
                    Case "StartInfoWindowStyle"
                        s = s & Proc.StartInfo.WindowStyle.ToString & " | "
                    Case "StartInfoCreateNoWindow"
                        s = s & Proc.StartInfo.CreateNoWindow & " | "

                        ' UPDATE TREEVIEW
                        ' /end update treeview

                End Select

            Next
        End If

        s = s.Substring(0, s.Length - 3)
        Return s

    End Function

    ' Updates all child tree nodes recursively.
    Private Sub CheckAllChildNodes(treeNode As TreeNode, nodeChecked As Boolean)
        Dim node As TreeNode
        For Each node In treeNode.Nodes
            node.Checked = nodeChecked
            If node.Nodes.Count > 0 Then
                ' If the current node has child nodes, call the CheckAllChildsNodes method recursively.
                Me.CheckAllChildNodes(node, nodeChecked)
            End If
        Next node
    End Sub

    ' NOTE   This code can be added to the BeforeCheck event handler instead of the AfterCheck event.
    ' After a tree node's Checked property is changed, all its child nodes are updated to the same value.
    Private Sub node_AfterCheck(sender As Object, e As TreeViewEventArgs) Handles SettsTree.AfterCheck
        ' The code only executes if the user caused the checked state to change.
        If e.Action <> TreeViewAction.Unknown Then
            If e.Node.Nodes.Count > 0 Then
                ' Calls the CheckAllChildNodes method, passing in the current 
                ' Checked value of the TreeNode whose checked state changed. 
                Me.CheckAllChildNodes(e.Node, e.Node.Checked)
            End If
        End If
    End Sub

    Private Sub StartBT_Click(sender As Object, e As EventArgs) Handles StartBT.Click
        ' MainRTB.AppendText("Process Id | Process Name | Window Handle | Window Title | Main Module FileName ")
        If StartBT.BackColor = Color.LimeGreen Then Return
        'Refresh Header
        HeaderTB.Text = "Time-ms [-] " & SelectedProperties() & vbCrLf

        MainRTB.AppendText("STARTED" & vbCrLf)
        MainRTB.AppendText(HeaderTB.Text)

        ProcTimer.Start()
        StartBT.BackColor = Color.LimeGreen

    End Sub

    Private Sub BTStop_Click(sender As Object, e As EventArgs) Handles BTStop.Click
        ProcTimer.Stop()
        MainRTB.AppendText("STOPPED" & vbCrLf)
        StartBT.BackColor = DefaultBackColor
    End Sub

    Private Function SelectedProperties() As String

        Dim s As String = Nothing

        RefreshPropsList()

        If RepProps.Count < 1 Then
            s = "NO PROPERTIES SELECTED   "
        Else
            For Each repprop As String In RepProps
                s = s & repprop & " | "
            Next
        End If

        s = s.Substring(0, s.Length - 3)
        Return s

    End Function

    Private Sub RefreshPropsList()
        RepProps.Clear()

        For Each cn As TreeNode In NodesToList(SettsTree, TraverseType.DepthFirst)
            'If Child Node is checked, add the name of the Child node to an array
            If cn.Checked And Microsoft.VisualBasic.Left(cn.Text, 2) <> "- " Then
                RepProps.Add(cn.Name)
            End If
        Next

    End Sub

    Public Enum TraverseType
        BreadthFirst
        DepthFirst
    End Enum

    Public Function NodesToList(ByVal TV As TreeView, Optional ByVal Traverse As TraverseType = TraverseType.BreadthFirst) As List(Of TreeNode)
        Dim nodes As New List(Of TreeNode)

        Select Case Traverse
            Case TraverseType.BreadthFirst
                Dim Q As New Queue(Of TreeNode)
                For Each TN As TreeNode In TV.Nodes
                    Q.Enqueue(TN)
                Next

                While Q.Count > 0
                    Dim TN As TreeNode = Q.Dequeue
                    nodes.Add(TN)
                    For Each subTN As TreeNode In TN.Nodes
                        Q.Enqueue(subTN)
                    Next
                End While

            Case TraverseType.DepthFirst
                Dim L As New List(Of TreeNode)
                For Each TN As TreeNode In TV.Nodes
                    L.Add(TN)
                Next

                While L.Count > 0
                    Dim TN As TreeNode = L.Item(0)
                    L.RemoveAt(0)
                    nodes.Add(TN)
                    For i As Integer = TN.Nodes.Count - 1 To 0 Step -1
                        L.Insert(0, TN.Nodes(i))
                    Next
                End While
        End Select

        Return nodes
    End Function


    '=======================================================
    'Service provided by Telerik (www.telerik.com)
    'Conversion powered by NRefactory.
    'Twitter: @telerik
    'Facebook: facebook.com/telerik
    '=======================================================


    Private Sub PlusBT_Click(sender As Object, e As EventArgs) Handles PlusBT.Click
        MainRTB.Font = New Font(MainRTB.Font.FontFamily, MainRTB.Font.Size + 1)
    End Sub

    Private Sub MinusBT_Click(sender As Object, e As EventArgs) Handles MinusBT.Click
        If MainRTB.Font.Size > 1 Then
            MainRTB.Font = New Font(MainRTB.Font.FontFamily, MainRTB.Font.Size - 1)
        End If

    End Sub

    Private Sub SettsBT_Click(sender As Object, e As EventArgs) Handles SettsBT.Click
        If SettsBT.BackColor = DefaultBackColor Then
            SettingsPN.Show()
            SettsBT.BackColor = Color.LimeGreen
            SplitMidPN.Panel2Collapsed = False
        Else
            SettingsPN.Hide()
            SettsBT.BackColor = DefaultBackColor
            SplitMidPN.Panel2Collapsed = True
        End If
    End Sub

    Private Sub CheckBox1_CheckedChanged(sender As Object, e As EventArgs) Handles RepPollChB.CheckedChanged
        My.Settings.RepPollTick = RepPollChB.Checked
        My.Settings.Save()
    End Sub

    Private Sub RepProcIDChB_CheckedChanged(sender As Object, e As EventArgs) Handles RepProcIDChB.CheckedChanged
        My.Settings.RepProcID = RepProcIDChB.Checked
        My.Settings.Save()
    End Sub

    Private Sub RepWndTitleChB_CheckedChanged(sender As Object, e As EventArgs) Handles RepWndTitleChB.CheckedChanged
        My.Settings.RepWndText = RepWndTitleChB.Checked
        My.Settings.Save()
    End Sub

    Private Sub RephWndChange_CheckedChanged(sender As Object, e As EventArgs) Handles RephWndChange.CheckedChanged
        My.Settings.RephWndChnage = RephWndChange.Checked
        My.Settings.Save()

    End Sub



    Private Sub FormSetup()

        'Fonts
        Me.Font = My.Settings.MainFont
        MainFontLB.Font = My.Settings.MainFont
        MainRTB.Font = My.Settings.ConsFont
        ConsFontLB.Font = My.Settings.ConsFont

        'MidPanel
        SplitMidPN.Panel2Collapsed = True

        'Checkboxes
        RepPollChB.Checked = My.Settings.RepPollTick
        RepProcIDChB.Checked = My.Settings.RepProcID
        RepWndTitleChB.Checked = My.Settings.RepWndText
        RephWndChange.Checked = My.Settings.RephWndChnage

        HighlightChangesChB.Checked = My.Settings.HighlightChanges

        TimerSet.Value = CInt(My.Settings.Pollms)

        'Labels
        VersionLB.Text = "V" & Version

    End Sub

    Private Sub TimerSet_ValueChanged(sender As Object, e As EventArgs) Handles TimerSet.Validated
        My.Settings.Pollms = TimerSet.Value
        My.Settings.Save()
        ProcTimer.Interval = TimerSet.Value
    End Sub

    Private Sub HighlightChangesChB_CheckedChanged(sender As Object, e As EventArgs) Handles HighlightChangesChB.CheckedChanged
        My.Settings.HighlightChanges = HighlightChangesChB.Checked
        My.Settings.Save()
    End Sub

    Private Sub clsBT_Click(sender As Object, e As EventArgs) Handles clsBT.Click
        MainRTB.SelectAll()
        MainRTB.SelectedText = ""
    End Sub

    Private Sub hrBT_Click(sender As Object, e As EventArgs) Handles hrBT.Click
        MainRTB.AppendText("===========================================================================" & vbCrLf)
    End Sub

    Private Sub ConsFontBT_Click(sender As Object, e As EventArgs) Handles ConsFontBT.Click
        FD1.Font = My.Settings.ConsFont
        FD1.ShowDialog()
        My.Settings.ConsFont = FD1.Font
        ConsFontLB.Font = FD1.Font
        MainRTB.Font = FD1.Font
        My.Settings.Save()
    End Sub

    Private Sub MainFontBT_Click(sender As Object, e As EventArgs) Handles MainFontBT.Click
        FD1.Font = My.Settings.MainFont
        FD1.ShowDialog()
        My.Settings.MainFont = FD1.Font
        MainFontLB.Font = FD1.Font
        Me.Font = FD1.Font
        My.Settings.Save()
    End Sub

    Private Sub Button1_Click(sender As Object, e As EventArgs)
        TimerSet.Value = 250
        RepProps.Clear()

        For Each cn As TreeNode In SettsTree.Nodes.Item(SettsTree.Nodes.IndexOfKey("Properties")).Nodes
            'If Child Node is checked, add the name of the Child node to an array
            If cn.Checked Then
                RepProps.Add(cn.Name)
            End If
        Next

        MainRTB.AppendText(vbCrLf & vbCrLf)

        For Each repprop As String In RepProps
            MainRTB.AppendText(repprop & vbCrLf)
        Next

    End Sub


#Region "TreeView Ops"

    Private Sub SaveNodes()

        SaveTreeToFile(UserDataFolder & "\TreeSetts.sav", SettsTree)

    End Sub

    Private Sub LoadNodes()

        LoadTreeFromFile(UserDataFolder & "\TreeSetts.sav", SettsTree)

    End Sub

    Private Sub SaveTreeToFile(f As String, t As TreeView)

        ' Save the treeview nodes to file
        Try
            Dim oTreeList As New List(Of clsTreeFile)

            For Each oNode As TreeNode In t.Nodes
                Dim oTree As New clsTreeFile

                oTree.oTreeNode = oNode
                oTreeList.Add(oTree)
            Next

            Using oFileStream As IO.FileStream = IO.File.Open(f, IO.FileMode.Create)
                Dim oBinaryFormatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter
                oBinaryFormatter.Serialize(oFileStream, oTreeList)
            End Using

            'MainRTB.AppendText("SYSTEM: Treeview saved successfully to: " & f & vbCrLf)

        Catch ex As Exception
            MainRTB.AppendText("SYSTEM: An error occurred while saving:" & ex.Message & vbCrLf)
        End Try
    End Sub

    Private Sub cmdClear_Click(t As TreeView)
        t.Nodes.Clear()
    End Sub

    Private Sub LoadTreeFromFile(f As String, t As TreeView)

        Try

            t.Nodes.Clear()

            Dim oTreeList As New List(Of clsTreeFile)

            Using oFileStream As IO.FileStream = IO.File.Open(f, IO.FileMode.Open)
                Dim oBinaryFormatter As New Runtime.Serialization.Formatters.Binary.BinaryFormatter
                oTreeList = CType(oBinaryFormatter.Deserialize(oFileStream), List(Of clsTreeFile))
            End Using

            For Each oNode As clsTreeFile In oTreeList
                t.Nodes.Add(oNode.oTreeNode)
            Next

            t.ExpandAll()

        Catch ex As Exception
            MainRTB.AppendText("SYSTEM: The '" & f & "' file cannot be opened: " & ex.Message & vbCrLf)
        End Try
    End Sub


#End Region

    Private Sub Button2_Click(sender As Object, e As EventArgs)
        LoadNodes()
    End Sub

    Private Sub Button3_Click(sender As Object, e As EventArgs)
        SaveNodes()
    End Sub

    Private Sub CopySelectedToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CopySelectedToolStripMenuItem.Click
        MainRTB.Copy()
    End Sub



    Private Sub CopyAllTextToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles CopyAllTextToolStripMenuItem.Click
        MainRTB.SelectAll()
        MainRTB.Copy()
        MainRTB.DeselectAll()
    End Sub

    Private Sub Button1_Click_1(sender As Object, e As EventArgs) Handles Button1.Click
        File.Delete(UserDataFolder & "\TreeSetts.sav")
        SkipTreeSave = True
        Me.Close()
    End Sub

    Private Sub Label3_Click(sender As Object, e As EventArgs) Handles Label3.Click

    End Sub
End Class

<Serializable()> _
Public Class clsTreeFile
    Public oTreeNode As TreeNode
End Class
